home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8504.arc / ART3.BAS next >
BASIC Source File  |  1986-09-14  |  2KB  |  54 lines
  1. 0  ' Graphics mode keyboard processor
  2. 10 '
  3. 20 SCREEN 1 : CLS : PRINT "KPROC example..." : PRINT
  4. 30 GOSUB 1030 ' initialize subroutine's special keys
  5. 40 ROW=9 : COL=10 : FL=8 : A$=SPACE$(FL)  ' set values for call
  6. 50 GOSUB 2030 ' call the subroutine
  7. 60 LOCATE 3,1 : PRINT "Read> ",A$
  8. 70 END
  9. 1000 '
  10. 1010 ' define constants for keyboard processor
  11. 1020 '
  12. 1030 K1=13  ' Enter - exit entry
  13. 1040 K2=8   ' BackSpace - cursor left and delete
  14. 1050 K3=27  ' Esc - blank field
  15. 1060 K4=331 ' move cursor to left
  16. 1070 K5=333 ' move cursor to right
  17. 1080 K6=338 ' Ins - insert a space
  18. 1090 K7=339 ' Del - delete character
  19. 1100 K8=95  ' ASCII cursor char code
  20. 1110 RETURN
  21. 2000 '
  22. 2010 '  keyboard processor
  23. 2020 '
  24. 2030 KC=0 : KP=1  '  blink count, char pointer
  25. 2040 KC=(KC+1) MOD 16:KS$=MID$(A$,KP,1)  ' blink a field char
  26. 2050 IF KC>7 THEN KS$=CHR$(K8)           '   or the "cursor"
  27. 2060 LOCATE ROW,COL+KP-1:PRINT KS$;      ' blink it
  28. 2070 K$=INKEY$ : IF K$="" THEN 2040      ' keystroke made?
  29. 2080 LOCATE ROW,COL+KP-1 
  30. 2085 PRINT MID$(A$,KP,1);          ' yes, clear blink
  31. 2087 ' convert to number
  32. 2090 KS=ASC(K$) : IF KS=0 THEN KS=256+ASC(RIGHT$(K$,1))  
  33. 2100 IF KS>31 AND KS<256 THEN 2250      ' bypass some
  34. 2110 '
  35. 2120 ' check for editing char's
  36. 2130 '
  37. 2140 IF KS=K1 THEN RETURN
  38. 2150 IF KS=K2 AND KP>1 THEN KS$=MID$(A$,KP,FL-KP+1)+" ":A$=MID$(A$,1,KP-2)+KS$:KP=KP-1:GOTO 2060
  39. 2160 IF KS=K3 THEN A$=SPACE$(FL):LOCATE ROW,COL:PRINT A$;:GOTO 2030
  40. 2170 IF KS=K4 THEN KP=KP+(KP>1):GOTO 2040
  41. 2180 IF KS=K5 THEN KP=KP-(KP<FL):GOTO 2040
  42. 2190 IF KS=K6 THEN KS$=" "+MID$(A$,KP,FL-KP):A$=MID$(A$,1,KP-1)+KS$:GOTO 2060
  43. 2200 IF KS=K7 THEN KS$=MID$(A$,KP+1,FL-KP)+" ":A$=MID$(A$,1,KP-1)+KS$:GOTO 2060
  44. 2210 BEEP : GOTO 2040 ' invalid edit char
  45. 2220 '
  46. 2230 ' save a char, display it and continue
  47. 2240 '
  48. 2250 MID$(A$,KP,1)=K$ : LOCATE ROW,COL+KP-1 : PRINT K$;
  49. 2260 KP=KP-(KP<FL) : GOTO 2040
  50. har, display it and continue
  51. 2240 '
  52. 2250 MID$(A$,KP,1)=K$ : LOCATE ROW,COL+KP-1 : PRINT K$;
  53. 2260 KP=KP-(KP<FL) : GOTO 2040
  54.